home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
NETFILE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-04-20
|
10KB
|
368 lines
UNIT NetFile;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Share aware file routines Last changed: 20.04.96 SA ║}
{║ ║}
{║ (C) Copyright 1989-94 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
INTERFACE
USES Use32, Dos,
PoPTypes;
CONST
NoKeep = False;
Keep = True;
NoWait = False;
Wait = True;
CONST { To Grab/Release File }
NetICFile = 0;
NetNLFile = 1;
TYPE
PNetFile = ^TNetFile;
TNetFile = OBJECT
f : File;
NetIo : Integer;
FName : PathStr;
CONSTRUCTOR OpenWithMode(CONST AFName: PathStr; ARecSize: Word; Create: Boolean; AMode: Word);
CONSTRUCTOR Open(CONST AFName: PathStr; ARecSize: Word; Create: Boolean);
DESTRUCTOR Close; VIRTUAL;
FUNCTION IoResult: Integer;
FUNCTION Lock(RecNum: LongInt; Wait: Boolean): Boolean;
PROCEDURE UnLock(RecNum: LongInt);
PROCEDURE GetRec(VAR Buffer; RecNum: LongInt; K,W: Boolean);
PROCEDURE PutRec(VAR Buffer; RecNum: LongInt);
PROCEDURE Read(VAR Buffer; K,W: Boolean);
PROCEDURE Write(VAR Buffer);
PROCEDURE BlockRead(VAR Buffer; Recs: Word);
PROCEDURE BlockReadNum(VAR Buffer; Recs: Word; VAR ActRecs: Word);
PROCEDURE ReadLine(VAR s: String);
PROCEDURE ReadLineBack(VAR s: String);
PROCEDURE BlockWrite(VAR Buffer; Recs: Word);
PROCEDURE WriteLine(s: String);
FUNCTION FileSize: LongInt;
FUNCTION FilePos: LongInt;
PROCEDURE Seek(RecNum: LongInt);
FUNCTION EoF: Boolean;
PROCEDURE Truncate;
FUNCTION RecSize: Word;
PROCEDURE CheckNetIo(CONST Where: S20);
END;
FUNCTION NetGrabFile(FileNum: Byte): Boolean;
PROCEDURE NetReleaseFile(FileNum: Byte);
PROCEDURE OpenLockFile;
PROCEDURE CloseLockFile;
IMPLEMENTATION
USES OpCrt, OpWindow, OpString, ApTimer,
Share, LogFile, OProUtil, Util, Globals, StrUtil;
VAR
LockFile : TNetFile;
FUNCTION NetGrabFile(FileNum: Byte): Boolean;
BEGIN
NetGrabFile:=LockFile.Lock(FileNum, True);
END;
PROCEDURE NetReleaseFile(FileNum: Byte);
BEGIN
LockFile.UnLock(FileNum);
END;
PROCEDURE OpenLockFile;
VAR
i,j : Byte;
BEGIN
LockFile.Open(StartPath+PoPNetFileName, 1, True);
j:=0;
IF LockFile.FileSize<>32 THEN
FOR i:=LockFile.FileSize TO 31 DO
LockFile.PutRec(j,i);
END;
PROCEDURE CloseLockFile;
BEGIN
LockFile.Close;
END;
CONSTRUCTOR TNetFile.OpenWithMode(CONST AFName: PathStr; ARecSize: Word; Create: Boolean; AMode: Word);
VAR
Tries: Byte;
BEGIN
FName:=ReplaceEnv(AFName);
NetIo:=0;
IF InOutRes<>0 THEN AddLog('!','Untrapped I/O Error '+Long2Str(IOResult)+' before opening: '+FName);
Assign(f, FName); FileMode:=AMode;
Tries:=0;
REPEAT
Reset(f, ARecSize);
NetIo:=System.IoResult;
IF (NetIo=2) And (Create) THEN
BEGIN
ReWrite(f, ARecSize);
NetIo:=System.IoResult;
IF NetIo=5 THEN
NetIo:=18
ELSE
BEGIN
System.Close(f);
NetIo:=255; { Try opening it now.... }
END;
END;
Inc(Tries);
UNTIL (NetIo IN [0,3,4]) OR ((NetIo=2) And Not Create) Or (Tries>=5);
IF (NetIO<>0) And (Tries>=5) And (Create) THEN
AddLog('!','I/O Error '+Long2Str(NetIo)+' when creating: '+FName);
IF NetIO=4 THEN AddLog('!', 'Too many open files - Increase FILES= in CONFIG.SYS');
IF NetIo<>0 THEN Fail;
END;
CONSTRUCTOR TNetFile.Open(CONST AFName: PathStr; ARecSize: Word; Create: Boolean);
BEGIN
IF NOT TNetFile.OpenWithMode(AFName, ARecSize, Create, ShareRW+ShareDenyNone) THEN Fail;
END;
DESTRUCTOR TNetFile.Close;
BEGIN
CheckNetIo('Close');
System.Close(f);
END;
FUNCTION TNetFile.IoResult: Integer;
BEGIN
IoResult:=NetIo;
NetIo:=0;
END;
FUNCTION TNetFile.Lock(RecNum: LongInt; Wait: Boolean): Boolean;
VAR
t : EventTimer;
i : Byte;
LockErr : Word;
WaitWin : WindowPtr;
NL : Boolean;
BEGIN
CheckNetIo('Lock');
NL:=Share.Lock(f, FileRec(f).RecSize*RecNum, FileRec(f).RecSize,LockErr);
IF NOT NL AND Wait THEN
BEGIN
MyWin(WaitWin,1,ScreenHeight-2,80,ScreenHeight,3,' Record locked ',False);
WaitWin^.wFastCenter(FName+', record '+Long2Str(RecNum),1,Cfg.Color[3].TextColor);
NewTimerSecs(t, 60);
REPEAT
Pause(200+(Cfg.TaskNumber*20));
NL:=Share.Lock(f, FileRec(f).RecSize*RecNum, FileRec(f).RecSize, LockErr);
UNTIL NL OR TimerExpired(t) OR GotESC;
IF NOT NL THEN AddLog(' ','Lock timeout on: '+FName+' ('+HexW(LockErr)+')');
KillWindow(WaitWin);
END;
Lock:=NL;
END;
PROCEDURE TNetFile.UnLock(RecNum: LongInt);
BEGIN
CheckNetIo('UnLock');
Share.UnLock(f,FileRec(f).RecSize*RecNum,FileRec(f).RecSize);
END;
PROCEDURE TNetFile.GetRec(VAR Buffer; RecNum: LongInt; K,W: Boolean);
BEGIN
CheckNetIo('GetRec');
Seek(RecNum);
NetIo:=System.IoResult;
IF NetIo<>0 THEN Exit;
IF NOT Lock(RecNum,W) THEN
BEGIN
NetIo:=107;
Exit;
END;
System.BlockRead(f,Buffer,1);
IF NOT K THEN UnLock(RecNum);
NetIo:=System.IoResult;
END;
PROCEDURE TNetFile.PutRec(VAR Buffer; RecNum: LongInt);
BEGIN
CheckNetIo('PutRec');
Seek(RecNum);
NetIo:=System.IoResult;
IF NetIo=0 THEN
BEGIN
System.BlockWrite(f,Buffer,1);
UnLock(RecNum);
NetIo:=System.IoResult;
END;
END;
PROCEDURE TNetFile.Read(VAR Buffer; K,W: Boolean);
BEGIN
CheckNetIo('Read');
IF EoF THEN
BEGIN
NetIo:=100;
END ELSE
IF NOT Lock(FilePos, W) THEN
BEGIN
IF W THEN Seek(FilePos+1);
InOutRes:=0;
NetIo:=107;
END ELSE
BEGIN
System.BlockRead(f, Buffer, 1);
IF NOT K THEN UnLock(FilePos-1);
NetIo:=System.IoResult;
END;
END;
PROCEDURE TNetFile.Write(VAR Buffer);
BEGIN
CheckNetIo('Write');
System.BlockWrite(f, Buffer, 1);
UnLock(FilePos-1);
NetIo:=System.IoResult;
END;
PROCEDURE TNetFile.BlockRead(VAR Buffer; Recs: Word);
BEGIN
CheckNetIo('BlockRead');
System.BlockRead(f, Buffer, Recs);
NetIo:=System.IoResult;
END;
PROCEDURE TNetFile.BlockReadNum(VAR Buffer; Recs: Word; VAR ActRecs: Word);
BEGIN
CheckNetIo('BlockReadNum');
System.BlockRead(f, Buffer, Recs, ActRecs);
NetIo:=System.IoResult;
END;
PROCEDURE TNetFile.ReadLine(VAR s: String);
VAR
OldPos : LongInt;
Buf : Array[0..254] Of Char;
Test : Word;
i : Byte;
BEGIN
CheckNetIo('ReadLine');
S:='';
OldPos:=System.FilePos(f);
System.BlockRead(f, Buf, SizeOf(Buf), Test);
i:=0;
WHILE (Test<>0) And (i<Test) AND (Buf[i]<>#10) DO
BEGIN
IF (Buf[i]<>#10) AND (Buf[i]<>#13) THEN S:=S+Buf[i];
Inc(i);
END;
Seek(OldPos+i+1);
IF System.IoResult<>0 THEN ;
END;
PROCEDURE TNetFile.ReadLineBack(VAR s: String);
VAR
x, OldPos : LongInt;
Buf : Array[1..255] Of Char;
Test : Integer;
i : Byte;
BEGIN
CheckNetIo('ReadLineBack');
S:='';
OldPos:=System.FilePos(f);
If OldPos>SizeOf(buf) Then
BEGIN
System.Seek(f, OldPos-SizeOf(Buf)-3);
i:=SizeOf(buf);
END ELSE
BEGIN
System.Seek(f, 0);
i:=OldPos;
END;
System.BlockRead(f, Buf, i, Test);
WHILE (Test<>0) And (i>0) AND (Buf[i]<>#10) DO
BEGIN
IF (Buf[i]<>#10) AND (Buf[i]<>#13) THEN S:=Buf[i]+S;
Dec(i);
END;
x:=OldPos-Test+i-1;
IF x<0 THEN x:=0;
System.Seek(f, x);
IF System.IoResult<>0 THEN ;
END;
PROCEDURE TNetFile.BlockWrite(VAR Buffer; Recs: Word);
BEGIN
CheckNetIo('BlockWrite');
System.BlockWrite(f, Buffer, Recs);
NetIo:=System.IoResult;
END;
PROCEDURE TNetFile.WriteLine(s: String);
BEGIN
CheckNetIo('WriteLine');
s:=s+#13#10;
System.BlockWrite(f, s[1], Length(s));
NetIo:=System.IoResult;
END;
FUNCTION TNetFile.FileSize: LongInt;
BEGIN
CheckNetIo('FileSize');
FileSize:=System.FileSize(f);
NetIo:=System.IoResult;
END;
FUNCTION TNetFile.EoF: Boolean;
BEGIN
CheckNetIo('EoF');
EoF:=System.EoF(f);
NetIo:=System.IoResult;
END;
FUNCTION TNetFile.FilePos: LongInt;
BEGIN
CheckNetIo('FilePos');
FilePos:=System.FilePos(f);
NetIo:=System.IoResult;
END;
PROCEDURE TNetFile.Seek(RecNum: LongInt);
BEGIN
CheckNetIo('Seek');
System.Seek(f, RecNum);
NetIo:=System.IoResult;
END;
PROCEDURE TNetFile.Truncate;
BEGIN
CheckNetIo('Truncate');
System.Truncate(f);
NetIo:=System.IoResult;
END;
FUNCTION TNetFile.RecSize: Word;
BEGIN
CheckNetIo('RecSize');
RecSize:=FileRec(f).RecSize;
END;
PROCEDURE TNetFile.CheckNetIo(CONST Where: S20);
BEGIN
IF NetIo<>0 THEN AddLog('!','Untrapped I/O Error '+Long2Str(NetIO)+' in TNetFile.'+Where+' of file: '+FName);
{ NetIo:=0;}
END;
END.